  subroutine mopy2mo_bbbb_s(icore, itmp, noa, nob, nva, nvb, nmo, l)   
  implicit none 
  integer, intent(in) :: nmo, nva, noa, nvb, nob, l
  real*4, intent(in) :: icore(nmo, nmo, nmo)
  real*4, intent(out) :: itmp(*)

  integer i, j, k, a, b, c, d 
  integer idx   
  integer noa2, nob2, noab, nva2, nvb2, nvab
  integer nvoa, nvob, nvaob, nvboa
  integer nfirst, nread
  real*8, external :: dnrm2
  noa2  = noa*(noa-1)/2
  nob2  = nob*(nob-1)/2
  noab  = noa*nob
  nva2  = nva*(nva-1)/2
  nvb2  = nvb*(nvb-1)/2
  nvab  = nva*nvb
  nvoa  = nva*noa
  nvob  = nvb*nob
  nvaob = nva*nob
  nvboa = nvb*noa 
  !BBBB
    !IJKL_BBBB
    if(l>1.and.l<=nob) then  
      do k = 1, l-1
      do j = 2, nob 
      do i = 1, j-1 
         !<ij||kl>=(ik|jl)-(jk|il)
         idx = (k-1)*nob2 + (j-1)*(j-2)/2 + i
         itmp(idx) = icore(i,k,j)  - icore(j,k,i) ! l
      enddo
      enddo
      enddo
      nfirst = (l-1)*(l-2)/2 + 1 
      nread = l-1
      call putlstso_s(itmp, nfirst, nread, 1, 1, 'IJKLBBS_')
    endif
    
    !ABIJ_BBBB
    if(l>1.and.l<=nob) then 
       j = l 
       do i = 1, j-1
       do b = 2, nvb
       do a = 1, b-1 
          ! <AB||IJ>=(AI|BJ)-(BI|AJ)
          idx = (i-1)*nvb2 + (b-1)*(b-2)/2 +a 
          itmp(idx) = icore(a+nob,i,b+nob) - icore(b+nob,i,a+nob)
       enddo
       enddo
       enddo
       nfirst = (j-1)*(j-2)/2 + 1 
       nread = j-1
       call putlstso_s(itmp, nfirst, nread, 1, 1, 'ABIJBBS_')
    endif

    !IABJ_BBBB
    if(l<=nob) then
       j = l
       do a = 1, nvb 
       do i = 1, nob
       do b = 1, nvb
          ! <IA||BJ>=(IB|AJ)-(AB|IJ)
          idx = (a-1)*nvob + (i-1)*nvb +b
          itmp(idx) = icore(i,b+nob,a+nob) - icore(a+nob,b+nob,i)
       enddo
       enddo
       enddo
       nfirst =(j-1)*nvb+1 
       nread = nvb
       call putlstso_s(itmp, nfirst, nread, 1, 1, 'BIAJBBBS')
    endif

    !ABCI_BBBB
    if(l<=nob) then  
    i=l 
    do c = 1, nvb
    do b = 2, nvb 
    do a = 1, b-1
       !<ab||ci> = (ac|bi)-(bc|ai)
       idx = (c-1)*nvb2 + (b-1)*(b-2)/2 + a
       itmp(idx) = icore(a+nob,c+nob,b+nob) - icore(b+nob,c+nob,a+nob) !i
    enddo
    enddo
    enddo
    nfirst = (i-1)*nvb + 1 
    nread = nvb
    call putlstso_s(itmp, nfirst, nread, 1, 1, 'ABCIBBS_')
    endif

    !IJKA_AAAA
    if(l>nob) then
    a = l-nob
    do k = 1, nob
    do j = 2, nob
    do i = 1, j-1
       !<ij||ka> = (ik|ja)-(jk|ia)
       idx = (k-1)*nob2 + (j-1)*(j-2)/2 + i
       itmp(idx) = icore(i,k,j) - icore(j,k,i) !i
    enddo
    enddo
    enddo
    nfirst = (a-1)*nob+1
    nread = nob
    call putlstso_s(itmp, nfirst, nread, 1, 1, 'IJKABBS_')
    endif

    !ABCD_BBBB
    if(l>nob+1) then
    d=l-nob
    do c = 1, d-1
    do b = 2, nvb
    do a = 1, b-1
       !<ab||cd> = (ac|bd)-(bc|ad)
       idx = (c-1)*nvb2 + (b-1)*(b-2)/2 + a
       itmp(idx) = icore(a+nob,c+nob,b+nob) - icore(b+nob,c+nob,a+nob) !i
    enddo
    enddo
    enddo
    nfirst = (d-1)*(d-2)/2 + 1
    nread = d-1
    call putlstso_s(itmp, nfirst, nread, 1, 1, 'ABCDBBS_')
    endif
  return
  end
    
  
